home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / windowDevice.icl < prev    next >
Encoding:
Modula Implementation  |  1997-06-16  |  17.2 KB  |  458 lines  |  [TEXT/3PRM]
  1. implementation module windowDevice;
  2.  
  3. import StdClass,StdInt, StdBool;
  4. import    pointer, structure, windows, quickdraw, events, controls, OS_utilities;
  5. import    commonDef, windowInternal, windowAccess;
  6. from    windowOpen        import OpenWindow;
  7. from    deltaWindow        import CloseWindows;
  8. from    deltaPicture    import Point;
  9. from    timerDevice        import TimerFunctions;
  10.  
  11.  
  12. CleanWindowRefCon    :== 1;
  13. WindowPtrRefCon        :== 152;
  14.  
  15. WindowFunctions :: DeviceFunctions *s;
  16. WindowFunctions
  17.     =    (ChangeAllWindowPtrs ShowWindow,
  18.             OpenWindow,
  19.                 WindowIO,
  20.             CloseWindow,
  21.          ChangeAllWindowPtrs HideWindow);
  22.  
  23.  
  24. WindowIO :: !Event !*s !(IOState *s) -> (!Bool, !*s, !IOState *s);
  25. WindowIO event=:(_,MouseDownEvent,_,_,h,v,_) s ioState
  26. |    region - 3 >= 6        = (False, s, IOStateSetToolbox        tb1        ioState2);
  27. |    not found            = (False, s, IOStateSetToolbox        tb1        ioState2);
  28. |    region == InContent    = MouseInContent event    wH windows    tb1 s    ioState2;
  29. |    region == InGoAway    = CheckGoAway            wH h v        tb1 s    ioState2;
  30. |    region == InDrag    = (True, s,  IOStateSetToolbox        tbDrag    ioState2);
  31. |    region == InGrow    = (True, s,  IOStateSetToolbox        tbGrow    ioGrow);
  32. |    region == InZoomIn
  33. ||    region == InZoomOut    = (True, s,  IOStateSetToolbox        tbZoom    ioZoom);
  34.                         = (True, s,  IOStateSetToolbox        tb1        ioState2);
  35.     where {
  36.         tbDrag            = Drag_window (WindowGetPtr window) h v tb1;
  37.         ioGrow            = IOStateSetWindow (wDef,grow) windows ioState2;
  38.         (grow, tbGrow)    = Do_grow_window window (WindowDefGetMinimumSize wDef) h v tb1;
  39.         ioZoom            = IOStateSetWindow (wDef,zoom) windows ioState2;
  40.         (zoom, tbZoom)    = Zoom_window window h v region tb1;
  41.         wH                = (wDef,window);
  42.         (tb, ioState1)                            = IOStateGetToolbox ioState;
  43.         (region, wPtr, tb1)                        = FindWindow h v tb;
  44.         (found, wDef, window, windows,ioState2)    = LocateWindow wPtr ioState1;
  45.     };
  46. WindowIO (_,MouseUpEvent,_,_,h,v,mods) s ioState
  47. |    not found            = (False, s,  IOStateSetToolbox tb1 ioState2);
  48. |    not (Enabled ms)    = (True,  s,  IOStateSetToolbox tb1 ioState2);
  49.                         = (True,  s1, ioState3);
  50.     where {
  51.         (s1, ioState3)    = MouseIO window (h,v) mods ButtonUp mf tb1 s ioState2;
  52.         (ms, mf)        = WindowDefGetMouse wDef;
  53.         (found, wDef, window, windows, ioState2)
  54.                         = LocateWindow wPtr ioState1;
  55.         (wPtr, tb1)        = FrontWindow tb;
  56.         (tb, ioState1)    = IOStateGetToolbox ioState;
  57.     };
  58. WindowIO event=:(_,keyEvent,_,_,_,_,_) s ioState
  59. |    keyEvent == KeyDownEvent
  60. ||    keyEvent == KeyUpEvent
  61. ||    keyEvent == AutoKeyEvent    = KeyboardIO event s ioState;
  62. WindowIO (_,UpdateEvent,wPtr,_,_,_,_) s ioState
  63. |    found        = (True,  s1, IOStateSetToolbox (EndUpdate wPtr tb4) ioUpdate);
  64.                 = (False, s,  IOStateSetToolbox (EndUpdate wPtr (BeginUpdate wPtr tb)) ioState2);
  65.     where {
  66.         (tb, ioState1)    = IOStateGetToolbox            ioState;
  67.         (found, wDef, window, windows, ioState2)
  68.                         = LocateWindow wPtr            ioState1;
  69.         (size,        tb1)= WindowGetFrameSize (wDef, window) tb;
  70.         (updWindow,    tb2)= WindowSetUpdateArea rect window tb1;
  71.         tb3                = BeginUpdate wPtr tb2;
  72.         (window2,s1,tb4)= Draw_window updWindow [rect] mode f s tb3;
  73.         ioUpdate        = IOStateSetWindow (wDef, window2) windows ioState2;
  74.         f                = WindowDefGetUpdate    wDef;
  75.         mode            = UpdateDrawMode        wDef;
  76.         rect            = (0,0, width,height);
  77.         (width, height)    = size;
  78.     };
  79. WindowIO (_,ActivateEvent,wPtr,_,_,_,mods) s ioState
  80. |    not found            = (False, s,  ioState1);
  81. |    activated            = (True,  sA, ioStateA);
  82.                         = (True,  sD, ioStateD);
  83.     where {
  84.         (sA, ioStateA)    = activateF    s (IOStateSelectWindow    (wDef, window) windows doActivation);
  85.         (sD, ioStateD)    = deactivateF    s (IOStateSetWindow    (wDef, window) windows doActivation);
  86.         activateF        = WindowDefGetActivate   wDef;
  87.         deactivateF        = WindowDefGetDeactivate wDef;
  88.         doActivation    = IOStateChangeToolbox display ioState1;
  89.         display            = DisplayWindow (IsScrollWindow wDef) activated window;
  90.         activated        = (mods bitand 1) <> 0;
  91.         (found, wDef, window, windows, ioState1)    = LocateWindow wPtr ioState;
  92.     };
  93. WindowIO _ s ioState
  94.     = (False, s, ioState);
  95.  
  96.  
  97. CheckGoAway :: !(WindowHandle *s) !Int !Int !Toolbox !*s !(IOState *s) -> (!Bool, !*s, !IOState *s);
  98. CheckGoAway (wDef, window) h v tb s ioState
  99. |    doGoAway    = (True, s1, ioState2);
  100.                 = (True, s,  ioState1);
  101.     where {
  102.         (s1, ioState2)    = goAway s ioState1;
  103.         goAway            = WindowDefGetGoAway wDef;
  104.         ioState1        = IOStateSetToolbox tb1 ioState;
  105.         (doGoAway, tb1)    = TrackGoAway (WindowGetPtr window) h v tb;
  106.     };
  107.  
  108.  
  109. MouseIO :: !Window !Point !Int !ButtonState !(MouseFunction *s (IOState *s)) !Toolbox !*s !(IOState *s)
  110.     ->    (!*s, ! IOState *s);
  111. MouseIO (wPtr,(hControl,_,_),(vControl,_,_),_,_,_) globPos mods buttonState mouseIO tb s ioState
  112.     =     mouseIO mouseState s (IOStateSetToolbox tb3 ioState);
  113.     where {
  114.         mouseState        = ((h2+hThumb, v2+vThumb), buttonState, INTToModifiers mods);
  115.         (h2,v2)            = local;
  116.         (local,  tb3)    = InGrafport wPtr (GlobalToLocal globPos) tb2;
  117.         (hThumb, tb1)    = GetCtlValue hControl tb;
  118.         (vThumb, tb2)    = GetCtlValue vControl tb1;
  119.     };
  120.  
  121.  
  122. KeyboardIO :: !Event !*s !(IOState *s) -> (!Bool, !*s, !IOState *s);
  123. KeyboardIO (_,keyEvent,message,_,_,_,mods) s ioState
  124. |    not found            = (False, s,  ioState2);
  125. |    not (Enabled ks)    = (True,  s , ioState2);
  126.                         = (True,  s1, ioState3);
  127.     where {
  128.         (wPtr,ioState1)    = IOStateAccessToolbox FrontWindow ioState;
  129.         (found, wDef, window, windows, ioState2)
  130.                         = LocateWindow wPtr ioState1;
  131.         (ks, kf)        = WindowDefGetKeyboard wDef;
  132.         keyState        = (toChar (message bitand 255), EventToKeyState keyEvent, INTToModifiers mods);
  133.         (s1, ioState3)    = kf keyState s ioState2;
  134.     };
  135.  
  136. EventToKeyState :: !Int -> KeyState;
  137. EventToKeyState KeyDownEvent    = KeyDown;
  138. EventToKeyState KeyUpEvent        = KeyUp;
  139. EventToKeyState AutoKeyEvent    = KeyStillDown;
  140.  
  141.  
  142. LocateWindow :: !WindowPtr !(IOState s)
  143.     -> (    !Bool,
  144.             !WindowDef s (IOState s),
  145.             !Window,
  146.             !DeviceSystemState s,
  147.             !IOState s
  148.         );
  149. LocateWindow wPtr ioState
  150.     =     (found, wDef, window, windows, ioState1);
  151.     where {
  152.         (wDef,    window)        = wH;
  153.         (found,    wH)            = Select (EqualWindowHandlePtr wPtr) (DummyWindowHandle wPtr) wHs;
  154.         (wHs, cursor)        = WindowSystemState_WindowHandles windows;
  155.         (windows,ioState1)    = IOStateGetDevice ioState WindowDevice;
  156.     };
  157.  
  158. Select :: !(Cond x) x ![x] -> (!Bool, x);
  159. Select c n [x : xs]
  160.     | c x        = (True, x);
  161.                 = Select c n xs;
  162. Select _ n _ = (False, n);
  163.  
  164. EqualWindowHandlePtr :: !WindowPtr !(WindowHandle s) -> Bool;
  165. EqualWindowHandlePtr wPtr wHandle = wPtr == WindowHandleGetPtr wHandle;
  166.  
  167. DisplayWindow :: !Bool !Bool !Window !Toolbox -> Toolbox;
  168. DisplayWindow False _ _ tb = tb;
  169. DisplayWindow documentWindow show (wPtr,(hControl,_,_),(vControl,_,_),_,_,_) tb
  170. |    show    = ShowControl vControl (ShowControl hControl tb1);
  171.             = HideControl vControl (HideControl hControl tb1);
  172.     where {
  173.         tb1 = DrawGrowIcon wPtr tb;
  174.     };
  175.  
  176. WindowGetScroll_and_Page :: !ControlHandle !Window !(!Int, !Int) -> (!Int, !Int);
  177. WindowGetScroll_and_Page control (_,(hControl,hScroll,_),(_,vScroll,_),_,_,_) (windowW, windowH)
  178. |    control == hControl    = (hScroll, dHpage - dHpage mod hScroll);
  179.                         = (vScroll, dVpage - dVpage mod vScroll);
  180.     where {
  181.         dHpage = windowW - hScroll;
  182.         dVpage = windowH - vScroll;
  183.     };
  184.  
  185. MouseInContent :: !Event !(WindowHandle *s) !(DeviceSystemState *s) !Toolbox !*s !(IOState *s)
  186.     ->    (!Bool, !*s, !IOState *s);
  187. MouseInContent event=:(b, mouseDown,mess,time,h,v,mods) w_and_h=:(wDef,window) ws tb s ioState
  188. |    notFront
  189. &&    WindowDefIsStandBy wDef        = WindowIO event s select;
  190. |    notFront                    = (True, s, select);
  191. |    part == InUpButton            = (True, sHiUp,    IOStateSetToolbox tbHiUp    ioHiUp);
  192. |    part == InDownButton        = (True, sHiDo,    IOStateSetToolbox tbHiDo    ioHiDo);
  193. |    part == InPageUp            = (True, sUp,    IOStateSetToolbox tbUp        ioUp);
  194. |    part == InPageDown            = (True, sDo,    IOStateSetToolbox tbDo        ioDo);
  195. |    part == InThumb                = (True, sThumb,IOStateSetToolbox tbThumb    ioThumb);
  196. |    h2 >= width || v2 >= height    = (True, s,        IOStateSetToolbox tb4        ioState);
  197. |    Enabled ms                    = (True, s2,    IOStateSetToolbox tb6        ioState5);
  198.                                 = (True, s,        IOStateSetToolbox tb4        ioState);
  199.     where {
  200.         wPtr                    = WindowGetPtr window;
  201.         (frontPtr, tb1)            = FrontWindow tb;
  202.         (local, tb2)            = InGrafport wPtr (GlobalToLocal (h,v)) tb1;
  203.         (h2, v2)                = local;
  204.         (part, control, tb3)    = FindControl h2 v2 wPtr tb2;
  205.         select                    = IOStateSetToolbox (SelectWindow wPtr tb1) ioState;
  206.         (size, tb4)                = WindowGetFrameSize w_and_h tb3;
  207.         (width, height)            = size;
  208.         (dScroll, dPage)        = WindowGetScroll_and_Page control window size;
  209.         f                        = WindowDefGetUpdate wDef;
  210.         (hiUp, sHiUp, tbHiUp)    = DoHilitControl control window part (decControl dScroll control) f s tb4;
  211.         (hiDo, sHiDo, tbHiDo)    = DoHilitControl control window part (incControl dScroll control) f s tb4;
  212.         (up,     sUp, tbUp)        = DoControl         control window part (decControl dPage   control) f s tb4;
  213.         (down, sDo,      tbDo)        = DoControl         control window part (incControl dPage   control) f s tb4;
  214.         (thumb,sThumb,tbThumb)    = MoveThumb control window h2 v2 f s tb4;
  215.         ioHiUp                    = IOStateSetWindow (wDef, hiUp) ws ioState;
  216.         ioHiDo                    = IOStateSetWindow (wDef, hiDo) ws ioState;
  217.         ioUp                    = IOStateSetWindow (wDef, up)    ws ioState;
  218.         ioDo                    = IOStateSetWindow (wDef, down)    ws ioState;
  219.         ioThumb                    = IOStateSetWindow (wDef,thumb)    ws ioState;
  220.         (tb6, s2, ioState5)        = TrackMouseStillDown wPtr timerIO tb5 s1 ioState4;
  221.         (tb5, ioState4)            = IOStateGetToolbox ioState3;
  222.         (_,_,timerIO,_,_)        = TimerFunctions;
  223.         (s1, ioState3)            = MouseIO window (h,v) mods button mf tb4 s ioState2;
  224.         (button,ioState2)        = IOStateButtonFreq time (h2, v2) wPtr ioState;
  225.         (ms, mf)                = mouse;
  226.         mouse                    = WindowDefGetMouse wDef;
  227.         notFront                = wPtr <> frontPtr;
  228.     };
  229.  
  230.  
  231. TrackMouseStillDown :: !WindowPtr !(DoIOFunction *s) !Toolbox !*s !(IOState *s)
  232.     ->    (!Toolbox, !*s, ! IOState *s);
  233. TrackMouseStillDown frontWindow timerIO tb s ioState
  234. |    frontWindow <> frontPtr    = (tb1, s, ioState)
  235. |    not found                = (tb2, s, ioState1)
  236. |    not (Enabled ms)        = (tb2, s, ioState1)
  237. |    timer                    = (tb3, s1,ioState3)
  238. |    not mouseDown            = (tb4, s1,ioState3)
  239.                             = TrackMouseStillDown frontWindow timerIO tb9 s2 ioState5;
  240.     where {
  241.         (frontPtr,tb1)    = FrontWindow tb;
  242.         (time,      tb2)    = TickCount tb1;
  243.         (found, wDef, window, windows, ioState1)
  244.                         = LocateWindow frontWindow ioState;
  245.         (timer, s1, ioState2)
  246.                         = timerIO event` s (IOStateSetToolbox tb2 ioState1);
  247.         event`            = (True, NullEvent, 0, time, 0, 0, 0);
  248.         mouse            = WindowDefGetMouse wDef;
  249.         (ms, mf)        = mouse;
  250.         (tb3, ioState3)    = IOStateGetToolbox ioState2;
  251.         (mouseDown,tb4)    = StillDown tb3;
  252.         (s2,  ioState4)    = mf mouseState s1 (IOStateSetToolbox tb8 ioState3);
  253.         (tb9, ioState5)    = IOStateGetToolbox ioState4;
  254.         mouseState        = ((h + hThumb,v + vThumb), ButtonStillDown, KeyMapToModifiers (k1,k2,k3,k4));
  255.         (mousePos, tb5)    = InGrafport frontWindow GetMousePosition tb4;
  256.         (h, v)            = mousePos;
  257.         (hThumb, tb6)    = GetCtlValue hControl tb5;
  258.         (vThumb, tb7)    = GetCtlValue vControl tb6;
  259.         (hControl, hScroll, hMax)                = hBar;
  260.         (vControl, vScroll, vMax)                = vBar;
  261.         (wPtr, hBar, vBar, pict, updArea, zoom)    = window;
  262.         (k1,k2,k3,k4,tb8)                        = GetKeys tb7;
  263.     };
  264.  
  265.  
  266. GetMousePosition :: !Toolbox -> (!Point, !Toolbox);
  267. GetMousePosition tb
  268.     =     ((x,y),tb1);
  269.     where {
  270.         (x, y, tb1) = GetMouse tb;
  271.     };
  272.  
  273.  
  274. TrackMouseWhileDown :: !Toolbox -> Toolbox;
  275. TrackMouseWhileDown tb
  276. |    stillDown    = TrackMouseWhileDown tb1;
  277.                 = tb1;
  278.     where {
  279.         (stillDown, tb1) = WaitMouseUp tb;
  280.     };
  281.  
  282. incControl :: !Int !ControlHandle !Toolbox -> Toolbox;
  283. incControl delta control tb
  284. |    nv > max        = SetCtlValue control max tb2;
  285.                     = SetCtlValue control nv  tb2;
  286.     where {
  287.         (v,    tb1)    = GetCtlValue    control tb;
  288.         (max, tb2)    = GetCtlMax    control tb1;
  289.         nv            = v + delta;
  290.     };
  291.  
  292. decControl :: !Int !ControlHandle !Toolbox -> Toolbox;
  293. decControl delta control tb
  294. |    nv < min                = SetCtlValue control min tb2;
  295. |    v == max && 0 <> mod_v    = SetCtlValue control (v - mod_v) tb3;
  296.                             = SetCtlValue control nv tb3;
  297.     where {
  298.         (v,      tb1)    = GetCtlValue control tb;
  299.         (min, tb2)    = GetCtlMin    control tb1;
  300.         (max, tb3)    = GetCtlMax    control tb2;
  301.         mod_v        = (v - min) mod delta;
  302.         nv            = v - delta;
  303.     };
  304.  
  305. WindowSetThumbs :: !Window !Int !Int !Int !Int !(!Int, !Int) !(UpdateFunction *s) !*s !Toolbox
  306.     ->    (!Window, !*s, !Toolbox);
  307. WindowSetThumbs window=:(wPtr,hBar,vBar,pict,_,zoom) tH tV oldtH oldtV (w, h) f s tb
  308. |    WindowGetPtr window == frontPtr
  309.     =    Scroll_window window1 oldtH oldtV tH tV f s1 (Set_thumbs window1 tH tV tb2);
  310.     =    UpdateWindow (wPtr,hBar,vBar,pict,updArea,zoom) rect f s [((0,0),(w,h))]
  311.             (Set_thumbs window tH tV tb1);
  312.     where {
  313.         (frontPtr,      tb1)    = FrontWindow tb;
  314.         (window1, s1, tb2)    = UpdateWindow window rect f s updArea tb1;
  315.         rect                = (0,0, w,h);
  316.         updArea                = [((tH,tV),(tH+w,tV+h))];
  317.     };
  318.  
  319. UpdateWindow :: !Window !Rect !(UpdateFunction *s) !*s !UpdateArea !Toolbox
  320.     ->    (!Window, !*s, !Toolbox);
  321. UpdateWindow window=:(wPtr,_,_,_,_,_) rect f s upd tb
  322.     =     (window2, s2, EndUpdate wPtr tb4);
  323.     where {
  324.         (window2, s2, tb4)    = Draw_window window1 [rect] HasControls f s tb3;
  325.         (window1,      tb3)    = WindowSetUpdateArea rect window tb2;
  326.         tb2                    = BeginUpdate wPtr tb1;
  327.         tb1                    = Update_window upd wPtr tb;
  328.     };
  329.  
  330. Set_thumbs :: !Window !Int !Int !Toolbox -> Toolbox;
  331. Set_thumbs (_,(hControl,_,_),(vControl,_,_),_,_,_) hThumb vThumb tb
  332.     =    SetCtlValue vControl vThumb (SetCtlValue hControl hThumb tb);
  333.  
  334.  
  335. //    Getting the current cursor shape and content:
  336.  
  337. IOStateGetCursorPos :: !(IOState s) -> (!Bool, !Bool, !WindowPtr, !IOState s);
  338. IOStateGetCursorPos ioState
  339. |    wPtr<>0        = (global, inContent, wPtr, IOStateSetToolbox tb4 ioState2);
  340.                     with {
  341.                         (locMousePos, tb2)        = InGrafport wPtr GetMousePosition tb1;
  342.                         (globMousePos,tb3)        = InGrafport wPtr (LocalToGlobal locMousePos) tb2;
  343.                         (global,inContent,tb4)    = WindowsGetCursorPos wPtr globMousePos windows tb3;
  344.                     };
  345.                 = (global, False, wPtr, IOStateSetToolbox tb1 ioState2);
  346.                     with {
  347.                         global    = (\(WindowSystemState (_,gCursor))->IsGlobalCursorSet gCursor) windows;
  348.                     };
  349.     where {
  350.         (windows, ioState1)        = IOStateGetDevice ioState WindowDevice;
  351.         (tb, ioState2)            = IOStateGetToolbox ioState1;
  352.         (wPtr, tb1)                = FrontWindow tb;
  353.     };
  354.  
  355. WindowsGetCursorPos    :: !WindowPtr !Point !(DeviceSystemState s) !Toolbox -> (!Bool, !Bool, !Toolbox);
  356. WindowsGetCursorPos wPtr (x,y) (WindowSystemState ([wH : wHs], gCursor)) tb
  357. |    wPtr <> (WindowHandleGetPtr wH)    = (IsGlobalCursorSet gCursor, False,    tb );
  358.                                     = (IsGlobalCursorSet gCursor, inContent,tb2);
  359.     where {
  360.         inContent        = IsBetween x l (l+w) && IsBetween y t (t+h);
  361.         (size,   tb1)    = WindowGetFrameSize wH tb;
  362.         (corner, tb2)    = InGrafport wPtr (LocalToGlobal (0,0)) tb1;
  363.         (w,h)            = size;
  364.         (l,t)            = corner;
  365.     };
  366. WindowsGetCursorPos _ _ (WindowSystemState (_,gCursor)) tb
  367.     =     (IsGlobalCursorSet gCursor, False, tb);
  368.  
  369. IOStateGetLocalCursor :: !(IOState s) -> (!CursorShape, !IOState s);
  370. IOStateGetLocalCursor ioState
  371.     =    (WindowsGetLocalCursor windows, ioState1);
  372.     where {
  373.         (windows, ioState1) = IOStateGetDevice ioState WindowDevice;
  374.     };
  375.  
  376. IOStateGetGlobalCursor :: !(IOState s) -> (!CursorShape, !IOState s);
  377. IOStateGetGlobalCursor ioState
  378.     =    (WindowsGetGlobalCursor windows, ioState1);
  379.     where {
  380.         (windows, ioState1) = IOStateGetDevice ioState WindowDevice;
  381.     };
  382.  
  383. WindowsGetLocalCursor :: !(DeviceSystemState s) -> CursorShape;
  384. WindowsGetLocalCursor (WindowSystemState ([(wDef,_) : _],_))    = WindowDefGetCursor wDef;
  385. WindowsGetLocalCursor _                                            = StandardCursor;
  386.  
  387. WindowsGetGlobalCursor :: !(DeviceSystemState s) -> CursorShape;
  388. WindowsGetGlobalCursor (WindowSystemState (_,GlobalCursorSet cShape))    = cShape;
  389. WindowsGetGlobalCursor _                                                = StandardCursor;
  390.  
  391. IsGlobalCursorSet :: !GlobalCursor  -> Bool;
  392. IsGlobalCursorSet NoGlobalCursor    = False;
  393. IsGlobalCursorSet _                    = True;
  394.  
  395.  
  396. //    Set the cursor shape.
  397.  
  398.  
  399. IBeamC    :== 1;
  400. CrossC    :== 2;
  401. PlusC    :== 3;
  402. WatchC    :== 4;
  403.  
  404. IOStateSetCursorShape :: !CursorShape !(IOState s) -> IOState s;
  405. IOStateSetCursorShape StandardCursor ioState = IOStateChangeToolbox  QInitCursor             ioState;
  406. IOStateSetCursorShape BusyCursor     ioState = IOStateChangeToolbox (QSetCursorShape WatchC) ioState;
  407. IOStateSetCursorShape IBeamCursor    ioState = IOStateChangeToolbox (QSetCursorShape IBeamC) ioState;
  408. IOStateSetCursorShape CrossCursor    ioState = IOStateChangeToolbox (QSetCursorShape CrossC) ioState;
  409. IOStateSetCursorShape FatCrossCursor ioState = IOStateChangeToolbox (QSetCursorShape PlusC ) ioState;
  410. IOStateSetCursorShape HiddenCursor   ioState = IOStateChangeToolbox  QHideCursor             ioState;
  411. IOStateSetCursorShape other_cursor   ioState = IOStateChangeToolbox  QInitCursor             ioState;
  412.  
  413. QSetCursorShape    :: !Int !Toolbox -> Toolbox;
  414. QSetCursorShape cursorId tb
  415.     =    tb4
  416.     where {
  417.         (cursorH,tb1)    = GetCursor cursorId tb;
  418.         (cShape, tb2)    = LoadLong cursorH tb1;
  419.         tb3                = QSetCursor cShape tb2;
  420.         tb4                = QShowCursor tb3;
  421.     };
  422.  
  423.  
  424. //    Access-rules.
  425.  
  426. IOStateSelectWindow :: !(WindowHandle s) !(DeviceSystemState s) !(IOState s) -> IOState s;
  427. IOStateSelectWindow wH windowSystemState ioState
  428.     =    let! {
  429.             wHs1;
  430.         } in
  431.     IOStateSetDevice ioState (WindowSystemState ([wH : wHs1], cursor));
  432.     where {
  433.         (_,_,wHs1)        = Remove (EqualWindowHandlePtr wPtr) wH wHs;
  434.         wPtr            = WindowHandleGetPtr wH;
  435.         (wHs, cursor)    = WindowSystemState_WindowHandles windowSystemState;
  436.     };
  437.  
  438. IOStateSetWindow :: !(WindowHandle s) !(DeviceSystemState s) !(IOState s) -> IOState s;
  439. IOStateSetWindow wH windowSystemState ioState
  440.     =    let! {
  441.             wHs1;
  442.         } in
  443.     IOStateSetDevice ioState (WindowSystemState (wHs1, cursor));
  444.     where {
  445.         (_,wHs1)        = Replace (EqualWindowHandlePtr wPtr) wH wHs;
  446.         wPtr            = WindowHandleGetPtr wH;
  447.         (wHs, cursor)    = WindowSystemState_WindowHandles windowSystemState;
  448.     };
  449.  
  450. Replace :: !(Cond x) x ![x] -> (!Bool, ![x]);
  451. Replace c y [x : xs]
  452. |    c x        = (True, [y : xs]);
  453.             = (b, [x : xs`]);
  454.     where {
  455.         (b, xs`) = Replace c y xs;
  456.     };
  457. Replace _ _ xs = (False, xs);
  458.